home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d1
/
go2.arc
/
GO.BAS
next >
Wrap
BASIC Source File
|
1989-07-21
|
6KB
|
255 lines
'$INCLUDE: 'QB.BI'
DEFINT A-Z
TYPE DTAType
reserved AS STRING * 21
attrib AS STRING * 1
WriteTime AS INTEGER
WriteDate AS INTEGER
Size AS LONG
FileName AS STRING * 13
END TYPE
DECLARE SUB ParseCommandLine ()
DECLARE SUB Help ()
DECLARE SUB Done ()
DECLARE SUB TestDir ()
DECLARE FUNCTION GetDrive% ()
DECLARE SUB SetDrive (Drive%)
DECLARE FUNCTION GetCurrDir$ ()
DECLARE FUNCTION DOSFindFirst% (Spec$, attrib%)
DECLARE FUNCTION DOSFindNext% ()
DECLARE SUB SetDTA (DTA AS DTAType)
CONST FALSE = 0
CONST TRUE = NOT FALSE
CLEAR , , 3000
DIM SHARED FileSearch, DirSearch
DIM SHARED OrigDrive, OrigDir$
DIM SHARED SearchDrive
DIM SHARED DIRSearchString$, DIRSearchLength
DIM SHARED FileSearchString$
DIM SHARED ResetDrive, ResetDir
DIM SHARED ParamCount, Param$(10)
DIM SHARED InRegs AS RegType, OutRegs AS RegType
DIM SHARED InRegsX AS RegTypeX, OutRegsX AS RegTypeX
FileSearch = TRUE
DirSearch = TRUE
ResetDrive = FALSE
ResetDir = FALSE
CONST NORMAL = 0
CONST SUBDIR = &H10
'++++++++++++++++++++++++++++++++++++
' Program begins here
'++++++++++++++++++++++++++++++++++++
ParseCommandLine
IF ParamCount < 1 OR ParamCount > 2 THEN
Help
END
END IF
OrigDrive = GetDrive
OrigDir$ = GetCurrDir$
IF ParamCount = 2 THEN
IF Param$(2) = "-F" OR Param$(2) = "/F" THEN
DirSearch = FALSE
ELSE
Help
END IF
END IF
SearchString$ = Param$(1)
IF MID$(SearchString$, 2, 1) = ":" THEN
NewDrive = ASC(LEFT$(SearchString$, 1)) - ASC("A")
SetDrive (NewDrive)
ResetDrive = TRUE
SearchString$ = MID$(SearchString$, 3)
END IF
IF LEFT$(SearchString$, 1) = "\" THEN
SearchString$ = MID$(SearchString$, 2)
FileSearch = FALSE
END IF
IF INSTR(SearchString$, "?") OR INSTR(SearchString$, "*") THEN
DirSearch = FALSE
END IF
IF DirSearch THEN
DIRSearchString$ = SearchString$
DIRSearchLength = LEN(DIRSearchString$)
END IF
IF FileSearch THEN
FileSearchString$ = SearchString$
IF INSTR(FileSearchString$, ".") = 0 THEN
FileSearchString$ = FileSearchString$ + ".*"
END IF
END IF
IF DirSearch OR FileSearch THEN
CHDIR ("\")
TestDir
ResetDir = TRUE
Done
ELSE
Help
END IF
END
SUB ParseCommandLine
temp$ = LTRIM$(RTRIM$(UCASE$(COMMAND$))) + " "
ParamCount = 0
DO WHILE LEN(temp$) > 1
ParamCount = ParamCount + 1
Param$(ParamCount) = LEFT$(temp$, INSTR(temp$, " ") - 1)
temp$ = MID$(temp$, INSTR(temp$, " ") + 1)
LOOP
END SUB
SUB Help
PRINT "GO moves you quickly from one subdirectory to another"
PRINT "Syntax:"
PRINT " GO [d:][\]pathname [-F]"
PRINT " the pathname can be either the name of a directory or"
PRINT " the name of a file. It may contain wild cards."
PRINT
PRINT " If 'd:' is included, drive 'd:' will be used instead"
PRINT " of the current default drive."
PRINT
PRINT " If '\' is included at the beginning of the pathname,"
PRINT " only subdirectory names will be searched."
PRINT
PRINT " If '-F' or '/F' is included, or if pathname includes"
PRINT " wild card symbols, only file names will be searched."
PRINT
PRINT " Normally, both file names and subdirectory names are"
PRINT " searched to match the specified pathname."
PRINT
END
END SUB
SUB Done
IF ResetDir THEN
PRINT " Requested subdirectory not found" + CHR$(7)
CHDIR (OrigDir$)
ELSE
PRINT " New Directory: "; GetCurrDir$
END IF
IF ResetDrive THEN
SetDrive (OrigDrive)
END IF
END
END SUB
SUB TestDir
DIM LocalDTA AS DTAType
CALL SetDTA(LocalDTA)
CurrentDir$ = GetCurrDir$
IF DirSearch AND LEN(CurrentDir$) >= DIRSearchLength THEN
IF RIGHT$(CurrentDir$, DIRSearchLength) = DIRSearchString$ THEN
Done
END IF
END IF
IF FileSearch THEN
IF DOSFindFirst(FileSearchString$, NORMAL) THEN
Done
END IF
END IF
IF DOSFindFirst("*.*", SUBDIR) THEN
IF LocalDTA.attrib$ = CHR$(SUBDIR) AND LEFT$(LocalDTA.FileName$, 1) <> "." THEN
CHDIR (LocalDTA.FileName$)
TestDir
CALL SetDTA(LocalDTA)
CHDIR (CurrentDir$)
END IF
DO WHILE DOSFindNext
IF LocalDTA.attrib$ = CHR$(SUBDIR) AND LEFT$(LocalDTA.FileName$, 1) <> "." THEN
CHDIR (LocalDTA.FileName$)
TestDir
CALL SetDTA(LocalDTA)
CHDIR (CurrentDir$)
END IF
LOOP
END IF
END SUB
'++++++++++++++++++++++++++++++++++++
' DOS Interface Functions
'++++++++++++++++++++++++++++++++++++
FUNCTION DOSFindFirst (Spec$, attrib%)
' Calls DOS to find directory entry with attribute attrib%
' and file name matching Spec$. Returns TRUE if entry is
' found, else returns FALSE
temp$ = Spec$ + CHR$(0)
InRegsX.ax = &H4E00
InRegsX.cx = attrib
InRegsX.ds = VARSEG(temp$)
InRegsX.dx = SADD(temp$)
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
DOSFindFirst = ((OutRegsX.flags AND &H1) = 0)
END FUNCTION
FUNCTION DOSFindNext
'Calls DOS to see if there is another entry that meets the
'last specification sent to DOSFindFirst. If so, returns TRUE;
'else returns FALSE
InRegs.ax = &H4F00
CALL INTERRUPT(&H21, InRegs, OutRegs)
DOSFindNext = ((OutRegs.flags AND &H1) = 0)
END FUNCTION
FUNCTION GetCurrDir$
' Calls DOS to get the name of the current default subdirectory.
' Returns the directory as a string in the form \name.....
' so that the same string can be used with CHDIR
DIM temp AS STRING * 64
InRegsX.ax = &H4700
InRegsX.dx = 0
InRegsX.ds = VARSEG(temp$)
InRegsX.si = VARPTR(temp$)
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
GetCurrDir$ = "\" + LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
END FUNCTION
FUNCTION GetDrive%
'Calls DOS to get current drive letter. Returns drive as
'an integer (A = 0, B = 1, etc.)
InRegs.ax = &H1900
CALL INTERRUPT(&H21, InRegs, OutRegs)
GetDrive = OutRegs.ax AND 255
END FUNCTION
SUB SetDrive (Drive)
' Calls DOS to change the current default drive
InRegs.ax = &HE00
InRegs.dx = Drive
CALL INTERRUPT(&H21, InRegs, OutRegs)
END SUB
SUB SetDTA (DTA AS DTAType)
' Calls DOS to set the current disk transfer area (DTA) for use
' by DOSFindFirst and DOSFindNext
InRegsX.ax = &H1A00
InRegsX.ds = VARSEG(DTA)
InRegsX.dx = VARPTR(DTA)
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
END SUB